home *** CD-ROM | disk | FTP | other *** search
/ MacHack 1994 / MacHack 1994.toast / MacHack™ 1987-1994 / MacHack™ '87 / Source ƒ.sea / Source ƒ / Pascal ƒ / iso rotate.pas
Encoding:
Pascal/Delphi Source File  |  1987-02-27  |  21.8 KB  |  710 lines  |  [TEXT/MACA]
  1.  
  2. This is the source to the ICOSAHEDRON ROTATE program already posted in binhex
  3. form.
  4. (C) Copyright 1986 by the University of Utah Computer Center.
  5. Written by John Halleck (NSS 20620)
  6. This program was written in TML pascal.
  7. --------------------------------------------------------------------------
  8. PROGRAM Univ_of_Utah (INPUT, OUTPUT);
  9.  
  10. {            Icosahedron display program               }
  11. {   Copyright 1986 University of Utah Computer Center, }
  12. {      Written by John B. Halleck (NSS 20620)          }
  13.  
  14. {$i MemTypes.ipas  }
  15. {$i QuickDraw.ipas }
  16. {$i Osintf.ipas    }
  17. {$i ToolIntf.ipas  }
  18. {$T APPL UoUb}
  19.  
  20.  
  21.  
  22. CONST
  23.  
  24.    Full_Height = 128;    { How big is our screen image? }
  25.    Half_Height =  64;    { Height of half of a screen image }
  26.    Byte_Height =  16;    { Full_Height covered divide 8}
  27.  
  28.    PI = 3.141592653;  { Pi }
  29.  
  30.    Num_VERTICES = 12; { Vertices in an Icosahedron }
  31.    Num_FACES    = 20; { Faces in an Icosahedron    }
  32.    Num_EDGES    = 30; { Edges in an Icosahedron    }
  33.  
  34.    Num_Views    = 20; { Rotation in how many steps?}
  35.  
  36.  
  37.  
  38. TYPE
  39.  
  40.    Transform   = Array [1..3, 1..3] of Real; { Transformation matrices }
  41.  
  42.    Coordinates = Array [1..3] of Real; { 3 space coordinates. }
  43.  
  44.    View        = Packed Array [1..Full_Height, 1..Byte_Height] of 0..255;
  45.          { Storage for the views. }
  46.  
  47.    Apoint   = Record { Information we keep for each point   }
  48.           DX, DY : Integer;     { Display Coordinates.  }
  49.               Where  : Coordinates; { Original Coordinates. }
  50.           NowAt  : Coordinates; { Final Coordinates.    }
  51.           End;
  52.  
  53.    AnEdge   = Record { Information for each edge }
  54.           Visible:         Boolean; { Is the edge visible?        }
  55.           Start, Finish: Integer; { Which vertices does it connect? }
  56.           End;
  57.  
  58.    Aface    = Record { Information about each face }
  59.           BEdges:    Array [1..3] of integer; { What bounding edges    }
  60.           BVert:     Array [1..3] of integer; { What corner vertices   }
  61.           ONormal:     Coordinates;             { Original Surface Normal}
  62.           Normal:    Coordinates;             { Final Surface Normal   }
  63.           Shows:     Boolean;           {Is it visible?          }
  64.           End;
  65.  
  66.  
  67.  
  68.  
  69.  
  70. VAR
  71.  
  72.    Index:    Integer; { General loop index}
  73.  
  74.    { How does the Icosahedron connect together? }
  75.    Vertices: Array [1..Num_Vertices] of Apoint;
  76.    Edges:    Array [1..Num_Edges]    of AnEdge;
  77.    Faces:    Array [1..Num_Faces]    of Aface;
  78.  
  79.    Light:    Coordinates; {Where is the light source?}
  80.  
  81.    Patterns: Array [0..64] of Pattern; {Brightness patterns for shading}
  82.  
  83.    ImageTransform:    Transform;  { How to get to our viewing point. }
  84.    RotationTransform: Transform;  { How far we have rotated it.      }
  85.    TotalTransform:    Transform;  { Composition of the above.        }
  86.  
  87.    OurBitMaps  : Array [1..Num_Views] of Bitmap; { Storage for the frames }
  88.  
  89.    SystemGrafPtr: GrafPtr; { Where is TML pascal's window? }
  90.    SystemBitMap: Bitmap;   { Copy of that windows original bitmap }
  91.    Limits:  Rect;       { Boundrys of the window, more or less }
  92.  
  93.    Fifth : Real;  { Fractions of a complete circle }
  94.    Tenth : Real;
  95.  
  96.    Axis_X: Real; { Axis of rotation that we should rotate around. }
  97.    Axis_Y: Real;
  98.    Axis_Z: Real;
  99.  
  100. { ******************************************************************** }
  101.  
  102. { Identity rotation matrix }
  103.  
  104. Procedure IdentTransform (Var Atransform:Transform);
  105. Var Row, Column: Integer;
  106. Begin
  107. For Row := 1 to 3 do For Column := 1 to 3 do Atransform[Row,Column] := 0.0;
  108. For Row := 1 to 3 do Atransform[Row,Row] := 1.0
  109. End;
  110.  
  111.  
  112. { ******************************************************************** }
  113.  
  114. { Form rotation matrices }
  115.  
  116. { Rotation matrices for rotation around }
  117. {    X                 Y                  Z }
  118.  
  119. {   1   0   0        C   0   S        C   S   0   }
  120. {   0   C   S        0   1   0       -S   C   0   }
  121. {   0  -S   C       -S   0   C        0   0   1   }
  122.  
  123. { Where C= COS (Angle)   and   S= SIN (angle) }
  124.  
  125. { Around 1 means around X, 2 means around Y, and 3 means around Z}
  126.  
  127.  
  128. Procedure FormRot (Angle: Real; Around: Integer; Var Result: Transform);
  129. Var S, C: Real;
  130.     Left, Right: Integer; { The lower and upper row and column to fill }
  131. Begin
  132. IdentTransform (Result);
  133. S := SIN (Angle); C := COS (Angle);
  134. case Around of
  135.  1: Begin Left:=2; Right:=3 end;
  136.  2: Begin Left:=1; Right:=3 end;
  137.  3: Begin Left:=1; Right:=2 end;
  138.  end;
  139. Result [Left, Left] := C;   Result [Left, Right] := S;
  140. Result [Right,Left] :=-S;   Result [Right,Right] := C;
  141. End;
  142.  
  143. { ******************************************************************** }
  144.  
  145.  
  146. { Multiply two transformation matricies together forming a third }
  147.  
  148. Procedure TTransform (First, Second: Transform;  Var Result: Transform);
  149. Var Row, Column: integer;
  150. begin
  151. For Row := 1 to 3 do
  152.     For Column := 1 to 3 do
  153.         Result [Row, Column] := First[Row,1]*Second[1,Column]+
  154.                             First[Row,2]*Second[2,Column]+
  155.                 First[Row,3]*Second[3,Column]
  156. end;
  157.  
  158.  
  159.  
  160. { ******************************************************************** }
  161.  
  162. { Add the effect of doing a given rotation onto a transformation matrix }
  163.  
  164. Procedure AddRot (Angle: Real; Around: Integer; Var Result: Transform);
  165. Var Temp, Final: Transform;
  166. Begin
  167. FormRot (Angle, Around, Temp); TTransform (Result, Temp, Final);
  168. Result := Final
  169. End;
  170. { ******************************************************************** }
  171.  
  172.  
  173. { Transform a point by the Total transformation matrix. }
  174.  
  175. Procedure TPoint (What: Coordinates; Var Into:Coordinates);
  176. Var Dimension: Integer;
  177. begin
  178. For Dimension := 1 to 3 do
  179.      Into[Dimension] := What[1]*TotalTransform[1,Dimension]+
  180.                         What[2]*TotalTransform[2,Dimension]+
  181.             What[3]*TotalTransform[3,Dimension]
  182.   end;
  183.  
  184. { ******************************************************************** }
  185.  
  186. { Assuming the point given discribes a vector from the origin, produce }
  187. { a point that discribes a unit length vector from the origin.}
  188.  
  189. Procedure Normalize (Var ThePoint: Coordinates);
  190. var
  191.   Length: Real;
  192. begin
  193. Length := SQRT(ThePoint[1]*ThePoint[1]
  194.              + ThePoint[2]*ThePoint[2]
  195.          + ThePoint[3]*ThePoint[3]);
  196. ThePoint[1] := ThePoint[1] / Length;
  197. ThePoint[2] := ThePoint[2] / Length;
  198. ThePoint[3] := ThePoint[3] / Length
  199. end;
  200.  
  201.  
  202. { ******************************************************************** }
  203.  
  204. PROCEDURE INITIALIZE;
  205.  
  206. var  Edges_So_Far: Integer;
  207.  
  208. PROCEDURE INITPOINTS; { Where are the coordinates of an icosahedron? }
  209. { (Icosahedron with unit edges, with center at the origin) }
  210. BEGIN
  211. With Vertices[ 1] do begin
  212.   Where[1]:= 0.00000000; Where[3]:= 0.00000000; Where[2]:=-0.95105650 end;
  213. With Vertices[ 2] do begin
  214.   Where[1]:= 0.00000000; Where[3]:= 0.85065080; Where[2]:=-0.42532537 end;
  215. With Vertices[ 3] do begin
  216.   Where[1]:= 0.80901699; Where[3]:= 0.26286555; Where[2]:=-0.42532537 end;
  217. With Vertices[ 4] do begin
  218.   Where[1]:= 0.49999999; Where[3]:=-0.68819096; Where[2]:=-0.42532537 end;
  219. With Vertices[ 5] do begin
  220.   Where[1]:=-0.50000001; Where[3]:=-0.68819094; Where[2]:=-0.42532537 end;
  221. With Vertices[ 6] do begin
  222.   Where[1]:=-0.80901698; Where[3]:= 0.26286557; Where[2]:=-0.42532537 end;
  223. With Vertices[ 7] do begin
  224.   Where[1]:= 0.49999999; Where[3]:= 0.68819095; Where[2]:= 0.42532537 end;
  225. With Vertices[ 8] do begin
  226.   Where[1]:= 0.80901699; Where[3]:=-0.26286556; Where[2]:= 0.42532537 end;
  227. With Vertices[ 9] do begin
  228.   Where[1]:= 0.00000000; Where[3]:=-0.85065080; Where[2]:= 0.42532537 end;
  229. With Vertices[10] do begin
  230.   Where[1]:=-0.80901699; Where[3]:=-0.26286555; Where[2]:= 0.42532537 end;
  231. With Vertices[11] do begin
  232.   Where[1]:=-0.50000001; Where[3]:= 0.68819094; Where[2]:= 0.42532537 end;
  233. With Vertices[12] do begin
  234.   Where[1]:= 0.00000000; Where[3]:= 0.00000000; Where[2]:= 0.95105650 end
  235. END;
  236.  
  237.  
  238.  
  239. PROCEDURE INITFACES; { How are those vertices connected? }
  240. BEGIN
  241. With Faces[ 1] do begin Bvert[1]:=  1; Bvert[2]:= 3; Bvert[3]:= 2 end;
  242. With Faces[ 2] do begin Bvert[1]:=  1; Bvert[2]:= 4; Bvert[3]:= 3 end;
  243. With Faces[ 3] do begin Bvert[1]:=  1; Bvert[2]:= 5; Bvert[3]:= 4 end;
  244. With Faces[ 4] do begin Bvert[1]:=  1; Bvert[2]:= 6; Bvert[3]:= 5 end;
  245. With Faces[ 5] do begin Bvert[1]:=  1; Bvert[2]:= 2; Bvert[3]:= 6 end;
  246. With Faces[ 6] do begin Bvert[1]:=  2; Bvert[2]:= 7; Bvert[3]:=11 end;
  247. With Faces[ 7] do begin Bvert[1]:=  2; Bvert[2]:= 3; Bvert[3]:= 7 end;
  248. With Faces[ 8] do begin Bvert[1]:=  3; Bvert[2]:= 8; Bvert[3]:= 7 end;
  249. With Faces[ 9] do begin Bvert[1]:=  3; Bvert[2]:= 4; Bvert[3]:= 8 end;
  250. With Faces[10] do begin Bvert[1]:=  4; Bvert[2]:= 9; Bvert[3]:= 8 end;
  251. With Faces[11] do begin Bvert[1]:=  4; Bvert[2]:= 5; Bvert[3]:= 9 end;
  252. With Faces[12] do begin Bvert[1]:=  5; Bvert[2]:=10; Bvert[3]:= 9 end;
  253. With Faces[13] do begin Bvert[1]:=  5; Bvert[2]:= 6; Bvert[3]:=10 end;
  254. With Faces[14] do begin Bvert[1]:=  6; Bvert[2]:=11; Bvert[3]:=10 end;
  255. With Faces[15] do begin Bvert[1]:=  6; Bvert[2]:= 2; Bvert[3]:=11 end;
  256. With Faces[16] do begin Bvert[1]:= 11; Bvert[2]:= 7; Bvert[3]:=12 end;
  257. With Faces[17] do begin Bvert[1]:=  7; Bvert[2]:= 8; Bvert[3]:=12 end;
  258. With Faces[18] do begin Bvert[1]:=  8; Bvert[2]:= 9; Bvert[3]:=12 end;
  259. With Faces[19] do begin Bvert[1]:=  9; Bvert[2]:=10; Bvert[3]:=12 end;
  260. With Faces[20] do begin Bvert[1]:= 10; Bvert[2]:=11; Bvert[3]:=12 end;
  261. END;
  262.  
  263.  
  264. PROCEDURE INITnormals;
  265. { A normal vector to a face is a vector perpendicular to the face }
  266. { In this case, defined to point outwards. }
  267. var ThisFace: Integer;
  268.  
  269.       { One could compute the normal from the three edge vertices, and }
  270.     { in general this is correct.      But, since the Icosahedron is }
  271.     { defined around the origin, the normal is in the direction of   }
  272.     { the average of the directions to the vertices }
  273.     Procedure FindNormal (Vertex1, Vertex2, Vertex3: Integer;
  274.                           VAR Norm: Coordinates);
  275.       Var Index: Integer;
  276.      begin
  277.       { Find the average of the vertices }
  278.     For Index := 1 to 3 do
  279.       Norm[Index]:=(Vertices[Vertex1].Where[Index]
  280.                      +Vertices[Vertex2].Where[Index]
  281.                    +Vertices[Vertex3].Where[Index])/3.0;
  282.       { Make it a unit normal }
  283.     Normalize (Norm)
  284.       end;
  285. Begin
  286. { For each face, find the surface normal }
  287. for ThisFace := 1 to Num_Faces do With Faces[ThisFace] do
  288.     FindNormal (Bvert[1],Bvert[2],Bvert[3],ONormal)
  289. End;
  290.  
  291.  
  292.  
  293. PROCEDURE INITEDGES; { Given the face information, derive the edges }
  294. var
  295.  ThisFace: Integer;
  296.  
  297.      { IF an edge is not in the table, add it. }
  298.      Function ADDedge (Vertex1, Vertex2: Integer):Integer;
  299.      Var
  300.          First, Second: Integer;
  301.          ThisEdge: Integer;
  302.          Found: Boolean;
  303.      Begin
  304.      { Put edge in standard order }
  305.      if Vertex1<Vertex2 then Begin First := Vertex1; Second := Vertex2 end
  306.                         else Begin First := Vertex2; Second := Vertex1 end;
  307.  
  308.      { Search the table for it }
  309.      ThisEdge := 0; Found:= False;
  310.      Repeat
  311.      ThisEdge := ThisEdge+1;
  312.      if ThisEdge<=Edges_so_far then With Edges[ThisEdge] do
  313.         Found := (First = Start) AND (Second = Finish);
  314.      until (ThisEdge>=Edges_so_far) OR FOUND;
  315.  
  316.      { If we don't have one, add it on. }
  317.      if Not Found then
  318.         Begin
  319.         Edges_So_far := Edges_So_far + 1;  ThisEdge := Edges_So_far;
  320.         With Edges[ThisEdge] do begin Start:=First; Finish:=Second end
  321.         end;
  322.  
  323.      { Return an index to it.}
  324.      AddEdge := ThisEdge
  325.      End;
  326.  
  327. BEGIN
  328. Edges_So_Far := 0;
  329.  
  330. { For each face, add its edges to the list }
  331. For ThisFace := 1 to Num_Faces do With Faces [ThisFace] do
  332.     Begin
  333.      Bedges[1] := AddEdge (Bvert[1], Bvert[2]);
  334.      Bedges[2] := AddEdge (Bvert[2], Bvert[3]);
  335.      Bedges[3] := AddEdge (Bvert[1], Bvert[3])
  336.     End;
  337. END;
  338.  
  339.  
  340.  
  341. { Come up with some shading patterns. }
  342.  
  343. Procedure InitPat;
  344. var Row, Column, Entry, Sample: integer;
  345.     Loc, Temp, Size: Integer;
  346.     TwoToThe: Array [0..7] of 0..255;
  347. Begin
  348. { Initialize a table of powers of 2 }
  349. Sample := 1;For Temp := 0 to 7 do Begin
  350.       TwoToThe [Temp] := Sample;
  351.       Sample := Sample + Sample
  352.       End;
  353.  
  354. { Start shading patterns Black }
  355. For Entry := 0 to 64 do For Row := 0 to 7 do Patterns[Entry][Row] := 0;
  356.  
  357. { Place dots in as evenly as practical }
  358. { The Macintosh has the convention that a bit =1 is black, and a }
  359. { a bit = 0 is white. }
  360. For Entry := 63 Downto 0 do
  361.     Begin
  362.     Loc:= Entry; Row:=0; Column:=0; Size:=8;
  363.     For Temp := 1 to 3 do
  364.        Begin
  365.           Row := Row+Row;  Column := Column+Column;
  366.       case Loc Mod 4 of
  367.            { Dither matrix recursively applied: }
  368.            { 0 3 }
  369.            { 2 1 }
  370.         0: ;
  371.         1: Begin Row:=Row+1; Column := Column+1 End;
  372.         2:       Row:=Row+1;
  373.         3:                   Column := Column+1;
  374.       end;
  375.       Loc := Loc div 4
  376.        end;
  377.     Sample := TwoToThe [Column];
  378.     For Temp := Entry Downto 0 do
  379.         Patterns[Temp][Row]:=Patterns[Temp][Row]+Sample
  380.     end
  381. end;
  382.  
  383.  
  384.  
  385. { Start out with no transformations }
  386. Procedure InitTransforms;
  387. Begin
  388. IdentTransform (TotalTransform);
  389. IdentTransform (RotationTransform);
  390. IdentTransform (ImageTransform);
  391. End;
  392.  
  393.  
  394.  
  395. { Get memory for the frames }
  396. Procedure InitFrames;
  397. Type Kludge = Record
  398.           Case Boolean of
  399.           true:   (ViewP: ^View);
  400.           false:  (NoneP: QDPtr);
  401.           end;
  402. Var
  403.   Index: Integer;
  404.   Hack:  Kludge;
  405. Begin
  406. { Obtain and Initialize frame records }
  407. For Index := 1 to Num_Views do With OurBitMaps [Index] do
  408.     Begin
  409.     Bounds   := Limits;
  410.     RowBytes := Byte_Height;
  411.     New (Hack.ViewP); BaseAddr := Hack.NoneP
  412.     End;
  413. end;
  414.  
  415.  
  416. { What axis should this thing seem to rotate around? }
  417. Procedure InitAxis;
  418. begin
  419.  
  420. { The direction }
  421. Axis_X := -Tenth;
  422. Axis_Y :=  0.0;
  423. Axis_Z :=  Tenth;
  424.  
  425. { Matrix to get us there }
  426. FormRot (Axis_X, 1, ImageTransform);
  427. AddRot  (Axis_Y, 2, ImageTransform);
  428. AddRot  (Axis_Z, 3, ImageTransform);
  429. end;
  430.  
  431.  
  432.  
  433. Procedure InitLight; { Set up the light source }
  434. { Shading is going to be Cosine shading.  Brightness is proportional to }
  435. { the cosine of the angle between Bright vector and the Eye.  Bright    }
  436. { Vector is the direction of the bright spot on the object, which is    }
  437. { Half way between the Eye and the light. }
  438.  
  439. Var  Eye: Coordinates; { Direction to the Eye }
  440. Begin
  441.  
  442. { Intended direction of light}
  443. Light[1] :=  3.0;   Light[2] := -1.0;    Light[3] := 1.0;
  444. Normalize (Light); { Unit directions only. }
  445.  
  446. { Direction of Eye. Forced by physical model, Don't Change this. }
  447. Eye  [1] :=  0.0;   Eye  [2] :=  0.0;    Eye  [3] := 1.0;
  448. Normalize (Eye);
  449.  
  450. { Average of unit vector to the eye and the light }
  451. Light[1]:=(Light[1]+Eye[1])/2.0;
  452. Light[2]:=(Light[2]+Eye[2])/2.0;
  453. Light[3]:=(Light[3]+Eye[3])/2.0;
  454. Normalize (Light)      { Make it a unit direction}
  455. End;
  456.  
  457.  
  458.  
  459.  
  460. BEGIN { Get everything we need }
  461. Fifth := (2*PI)/5.0; Tenth := PI/5.0;
  462. GetPort (SystemGrafPtr); SystemBitMap := SystemGrafPtr^.PortBits;
  463. SetRect (Limits, 0, 0, Full_Height, Full_Height);
  464. INITPOINTS; INITFACES; InitNormals; INITEDGES; InitPat;
  465. InitTransforms; InitFrames; InitAxis; InitLight
  466. END;
  467.  
  468.  
  469. { ******************************************************************** }
  470.  
  471. { Find the visible faces and edges }
  472.  
  473. Procedure FindVisible;
  474. Var
  475.   ThisFace: Integer; ThisEdge: Integer;
  476. begin
  477. For ThisEdge := 1 to Num_Edges do With Edges[ThisEdge] do Visible := False;
  478.  
  479. { For each face, if the face is visible, mark it and it's edges visible }
  480. For ThisFace := 1 to Num_Faces do With Faces[ThisFace] do
  481.    Begin
  482.    { Assuming that we have a CONVEX object, Then the face pointing towards }
  483.    { us means that it MUST be visible }
  484.    Shows := Normal [3] >= 0.0;
  485.    if Shows then
  486.       begin
  487.         Edges[Bedges[1]].Visible:=true;
  488.     Edges[Bedges[2]].Visible:=true;
  489.     Edges[Bedges[3]].Visible:=true
  490.       end
  491.    End
  492. end;
  493.  
  494. { ******************************************************************** }
  495.  
  496. { Compute Display Coordinates for each point}
  497. { (with the current transformation) }
  498.  
  499. Procedure SetDisplay;
  500. Var
  501.    ThisPoint: Integer;
  502. Begin
  503. { We assume that the Object is defined centered around the origin. }
  504. For ThisPoint := 1 to Num_Vertices do With Vertices[ThisPoint] do
  505.    Begin
  506.    DX := ROUND ((NowAt[1] + 1.0) * Half_Height);
  507.    DY := ROUND ((NowAt[2] + 1.0) * Half_Height)
  508.    End;
  509. End;
  510.  
  511. { ******************************************************************** }
  512.  
  513. { Display the visible edges }
  514.  
  515. Procedure DrawEdges;
  516. Var
  517.    ThisEdge : Integer;
  518. Begin
  519. SetDisplay;
  520. For ThisEdge := 1 to Num_Edges Do With Edges[ThisEdge] do if Visible then
  521.     BEGIN
  522.     With Vertices[Start]  do MoveTo (DX, DY);
  523.     With Vertices[Finish] do LineTo (DX, DY)
  524.     END
  525. End;
  526.  
  527. { ******************************************************************** }
  528.  
  529. { Compute the brightnesses of the faces. }
  530.  
  531. Procedure ShadeFaces;
  532. Var
  533.   ThisFace:Integer;
  534.   Aregion: RgnHandle;
  535.   Level:Integer;
  536.  
  537.     Function Bright (PlaneNorm, LightNorm: Coordinates):Real;
  538.     begin
  539.     { Brightness should be proportional to the cosine of the angle }
  540.     { between the face normal and the Bright spot.  The dot        }
  541.     { product of the Normal and the Bright spot vectors would give }
  542.     { Cosine angle * Length Bright * Length Face Normal,           }
  543.     { But since we have arranged for both lengths to be 1, this    }
  544.     { gives just Cosine Angle which is what we want.               }
  545.     Bright := ((PlaneNorm[1]*LightNorm[1] +
  546.                 PlaneNorm[2]*LightNorm[2] +
  547.             PlaneNorm[3]*LightNorm[3] ) + 1.0)/2.0
  548.     { We scale the value to lie between 0 (Black) and 1 (White)    }
  549.     end;
  550. Begin
  551. Aregion:=NewRgn;
  552. { For each visible face... }
  553. For ThisFace := 1 to Num_Faces do With Faces[ThisFace] do if Shows then
  554.     Begin
  555.  
  556.     { Form the region for the face for the MacIntosh primitives }
  557.     OpenRgn;
  558.     With Vertices[Bvert[3]] do MoveTo (DX, DY);
  559.     With Vertices[Bvert[1]] do LineTo (DX, DY);
  560.     With Vertices[Bvert[2]] do LineTo (DX, DY);
  561.     With Vertices[Bvert[3]] do Lineto (DX, DY);
  562.     CloseRgn (Aregion);
  563.  
  564.     { Fill with the computed brightness }
  565.     Level := Round (Bright (Normal, Light) * 64.0);
  566.     FillRgn (Aregion, Patterns[Level]);
  567.     SetEmptyRgn(Aregion)
  568.     end;
  569. DisposeRgn(Aregion)
  570. End;
  571.  
  572. { ******************************************************************** }
  573.  
  574.  
  575. { Transform the faces and vertices by the current transformation }
  576.  
  577. Procedure DoTransform;
  578. Var
  579.   ThisFace, ThisPoint: Integer;
  580.   Begin
  581. For ThisFace := 1 to Num_Faces do With Faces[ThisFace] do
  582.     TPoint (ONormal, Normal);
  583. For ThisPoint:= 1 to Num_Vertices do With Vertices[ThisPoint] do
  584.     Tpoint (Where, NowAt)
  585. End;
  586.  
  587. { ******************************************************************** }
  588.  
  589. { Build the current transformation from its parts, apply the transform, }
  590. { and compute the visible faces and edges. }
  591.  
  592. Procedure SetupFrame;
  593. Begin
  594. TTransform (RotationTransform, ImageTransform, TotalTransform);
  595. DoTransform; SetDisplay; FindVisible
  596. End;
  597.  
  598. { ******************************************************************** }
  599.  
  600. { Draw one frame }
  601. Procedure OutFrame;
  602. Begin
  603. SetupFrame; FillRect (Limits, Patterns[0]); ShadeFaces; DrawEdges
  604. end;
  605.  
  606. { ******************************************************************** }
  607.  
  608. { Draw the frames of the Object in each orientation. }
  609.  
  610. Procedure ComputeFrames;
  611. Var
  612.   Index: Integer;
  613.   This_Angle, Step_Angle: Real;
  614. Begin
  615. Step_Angle := Fifth / Num_Views; { Assume 5 fold rotational symetry }
  616. For Index:=1 to Num_Views do
  617.     Begin
  618.        This_Angle := Index * Step_Angle;
  619.        FormRot (This_Angle, 2, RotationTransform);
  620.        SetPortBits (OurBitMaps[Index]);
  621.        OutFrame;
  622.        CopyBits (OurBitMaps[Index], SystemBitMap, Limits, Limits, srcCopy,
  623.             SystemGrafPtr^.visRgn);
  624.     end;
  625. SetPortBits (SystemBitMap)
  626. end;
  627.  
  628.  
  629. { ******************************************************************** }
  630.  
  631. { Thumb through the frames, copying each to the screen.  Change the }
  632. { Aiming point (and thumb direction ) to mimic bouncing }
  633.  
  634. Procedure Thumb;
  635. Var Index: Integer;
  636.     Dest: Rect;
  637.     Offset_X, Direction_X: Integer;
  638.     Offset_Y, Direction_Y: Integer;
  639.     Direction_Rot: Integer;
  640.     Bounce: Rect;
  641. Begin
  642. Index   := 0; Direction_Rot:= 1;
  643. Offset_X:= 0; Direction_X  := 1;
  644. Offset_Y:= 0; Direction_Y  := 1;
  645. SetOrigin (0,0);
  646.  
  647. { Use TML pascals window }
  648. Bounce := SystemGrafPtr^.PortBits.Bounds;
  649. Bounce.Right := Bounce.Right - Full_Height;
  650. Bounce.Bottom := Bounce.Bottom - Full_Height;
  651. Dest := Limits;
  652.  
  653. While Not Button do
  654.   Begin
  655. { Select frame, Force wrap if off ends of frame list. }
  656.   Index := Index + Direction_Rot;
  657.   If Index > Num_Views then Index := 1 else
  658.   if Index < 1         then Index := Num_Views;
  659.  
  660. { Copy this frame to screen }
  661.   CopyBits (OurBitMaps[Index], SystemBitMap, Limits, Dest, srcCopy,
  662.             SystemGrafPtr^.visRgn);
  663.  
  664. { Update X, check for bounce }
  665.   Offset_X := Offset_X + direction_X;
  666.   if (Offset_X >Bounce.Right) or (Offset_X <Bounce.Left) Then
  667.      Begin
  668.      Direction_X := -Direction_X;
  669.      Direction_Rot := Direction_X*Direction_Y;
  670.      end;
  671.  
  672. { Update Y, check for bounce }
  673.   Offset_Y := Offset_Y + direction_Y;
  674.   if (Offset_Y >Bounce.Bottom) or (Offset_Y <Bounce.Top) Then
  675.      Begin
  676.      Direction_Rot := Direction_X*Direction_Y;
  677.      Direction_Y := -Direction_Y;
  678.      end;
  679.  
  680. { Update current location for transfer. }
  681.   Dest := Limits;
  682.   OffsetRect (Dest, Offset_X, Offset_Y);
  683.  
  684.   End;
  685.  
  686. While Button do { Nothing };
  687. end;
  688.  
  689.  
  690. { ******************************************************************** }
  691.  
  692.  
  693.  
  694. BEGIN
  695. ObscureCursor;
  696. Writeln ('                Icosahedron Version 0.6');
  697. Writeln ('  Copyright 1986 By the University of Utah Computer Center');
  698. Writeln ('          Written by John Halleck  (NSS 20620)');
  699. INITIALIZE;
  700. For Index := 64 Downto 0 do
  701.     FillRect (SystemGrafPtr^.PortBits.Bounds, Patterns[Index]);
  702. BackPat (Patterns[0]);
  703. SetupFrame;
  704. PenPat (Patterns[64]); DrawEdges;
  705. PenPat (Patterns[0]);  ShadeFaces; DrawEdges;
  706. ComputeFrames;
  707. Thumb
  708. END.
  709.  
  710.